Attribute VB_Name = "modRES"
'---------------------------------------------------------------------------------------
'Module : modRes
'Date   : 01/11/2008
'Author : Chris Elwell
'Purpose: This module has the routines and data types needed to determine if an address
'         is residential using the Address Verification web service.
'---------------------------------------------------------------------------------------

Option Explicit

'AddrData Type passed to IsResidential
Public Type AddrData
    Company As String
    Addr1 As String
    Addr2 As String
    City As String
    St As String
    Zip As String
End Type

Const KEY As String = "yOGtOgy2Hyp5DMQv"
Const PASSWORD As String = "RDap03Y9Zc6cxmalcYQehCZEE"
Const ACCTNUM As String = "226967028"
Const METERNUM As String = "3425042"
Const WEBSVCURL As String = "https://gateway.fedex.com:443/web-services"


Public Function IsResidential(ByRef AnAddr As AddrData) As Boolean
    Dim WinHttpReq As New WinHttp.WinHttpRequest
    Dim strSoap As String                      'stores SOAP transaction
    Dim FSO As New FileSystemObject
    Dim TSO As TextStream
    Dim strResResult As String
    
    Set TSO = FSO.CreateTextFile(App.Path & "\VERIFI.XML", True)
    
    '-----------------------------
    'Build verify SOAP transaction
    '-----------------------------
     strSoap = "<soapenv:Envelope" & vbCrLf
     strSoap = strSoap & "  xmlns:soapenv=" & Chr(34) & "http://schemas.xmlsoap.org/soap/envelope/" & Chr(34) & vbCrLf
     strSoap = strSoap & "  xmlns:v1=" & Chr(34) & "http://fedex.com/ws/addressvalidation/v1" & Chr(34) & vbCrLf
     strSoap = strSoap & "  xmlns:xsd=" & Chr(34) & "http://www.w3.org/2001/XMLSchema" & Chr(34) & vbCrLf
     strSoap = strSoap & "  xmlns:xsi=" & Chr(34) & "http://www.w3.org/2001/XMLSchema-instance" & Chr(34) & ">" & vbCrLf
     strSoap = strSoap & "  <soapenv:Body>" & vbCrLf
     strSoap = strSoap & "<v1:addressValidation>" & vbCrLf
     strSoap = strSoap & "<v1:AddressValidationRequest>" & vbCrLf
     strSoap = strSoap & "<v1:WebAuthenticationDetail>" & vbCrLf
     strSoap = strSoap & "<v1:UserCredential>" & vbCrLf
     strSoap = strSoap & "<v1:Key>" & KEY & "</v1:Key>" & vbCrLf
     strSoap = strSoap & "<v1:Password>" & PASSWORD & "</v1:Password>" & vbCrLf
     strSoap = strSoap & "</v1:UserCredential>" & vbCrLf
     strSoap = strSoap & "</v1:WebAuthenticationDetail>" & vbCrLf
     strSoap = strSoap & "<v1:ClientDetail>" & vbCrLf
     strSoap = strSoap & "<v1:AccountNumber>" & ACCTNUM & "</v1:AccountNumber>" & vbCrLf
     strSoap = strSoap & "<v1:MeterNumber>" & METERNUM & "</v1:MeterNumber>" & vbCrLf
     strSoap = strSoap & "</v1:ClientDetail>" & vbCrLf
     strSoap = strSoap & "<v1:TransactionDetail>" & vbCrLf
     strSoap = strSoap & "<v1:CustomerTransactionId>testfedex</v1:CustomerTransactionId>" & vbCrLf
     strSoap = strSoap & "</v1:TransactionDetail>" & vbCrLf
     strSoap = strSoap & "<v1:Version>" & vbCrLf
     strSoap = strSoap & "<v1:ServiceId>aval</v1:ServiceId>" & vbCrLf
     strSoap = strSoap & "<v1:Major>1</v1:Major>" & vbCrLf
     strSoap = strSoap & "<v1:Intermediate>1</v1:Intermediate>" & vbCrLf
     strSoap = strSoap & "<v1:Minor>0</v1:Minor>" & vbCrLf
     strSoap = strSoap & "</v1:Version>" & vbCrLf
     strSoap = strSoap & "<v1:RequestTimestamp>" & Format(Now, "YYYY-MM-DDTHH:MM:SS.000Z") & "</v1:RequestTimestamp>" & vbCrLf
     strSoap = strSoap & "<v1:Options>" & vbCrLf
     'strSoap = strSoap & "<v1:VerifyAddresses>true</v1:VerifyAddresses>" & vbCrLf
     strSoap = strSoap & "<v1:CheckResidentialStatus>true</v1:CheckResidentialStatus>" & vbCrLf
     strSoap = strSoap & "</v1:Options>" & vbCrLf
     strSoap = strSoap & "<v1:AddressesToValidate>" & vbCrLf
     strSoap = strSoap & "<v1:Address>" & vbCrLf
     strSoap = strSoap & "<v1:StreetLines>" & AnAddr.Addr1 & "</v1:StreetLines>" & vbCrLf
    If AnAddr.Addr2 <> "" Then strSoap = strSoap & "<v1:StreetLines>" & AnAddr.Addr2 & "</v1:StreetLines>" & vbCrLf
     strSoap = strSoap & "<v1:City>" & AnAddr.City & "</v1:City>" & vbCrLf
     strSoap = strSoap & "<v1:StateOrProvinceCode>" & AnAddr.St & "</v1:StateOrProvinceCode>" & vbCrLf
     strSoap = strSoap & "<v1:PostalCode>" & AnAddr.Zip & "</v1:PostalCode>" & vbCrLf
     strSoap = strSoap & "<v1:CountryCode>US</v1:CountryCode>" & vbCrLf
     strSoap = strSoap & "</v1:Address>" & vbCrLf
     strSoap = strSoap & "</v1:AddressesToValidate>" & vbCrLf
     strSoap = strSoap & "</v1:AddressValidationRequest>" & vbCrLf
     strSoap = strSoap & "</v1:addressValidation>" & vbCrLf
     strSoap = strSoap & "</soapenv:Body>" & vbCrLf
     strSoap = strSoap & "</soapenv:Envelope>" & vbCrLf
    
     '--------------------
     'Open an HTTP Request
     '--------------------
     WinHttpReq.Open "POST", WEBSVCURL, False
     
     '--------------------------------------------------------------
     'Build required HTTP header; Company name is used as User-Agent
     '--------------------------------------------------------------
     WinHttpReq.setRequestHeader "Referer", AnAddr.Company
     WinHttpReq.setRequestHeader "Content-type", "text/xml"
     WinHttpReq.setRequestHeader "Accept", "text/xml, image/x-xbitmap, image/jpeg, image/pjpeg, */*"
     WinHttpReq.setRequestHeader "Content-length", CStr(Len(strSoap))
    
    '---------------------
    'Send the HTTP Request
    '---------------------
    WinHttpReq.Send strSoap
    
    '---------------------------------------
    'Validate transmission connection
    '---------------------------------------
    If WinHttpReq.Status <> "200" Then
        
        Call WriteError(WinHttpReq.StatusText, AnAddr)
        IsResidential = False
        GoTo Release
        
    End If
    
    'Save XML reply
    TSO.WriteLine WinHttpReq.responseText
    TSO.Close
    
    'Get Residential result
    strResResult = GetResult(App.Path & "\VERIFI.XML")
    
    'If Residential return True
    If UCase(strResResult) = "RESIDENTIAL" Then
        IsResidential = True
    Else
        IsResidential = False
        If strResResult <> "BUSINESS" Then
            Call WriteError(strResResult, AnAddr)
        End If
    End If
    
Release:
    Set WinHttpReq = Nothing
    Set TSO = Nothing
    Set FSO = Nothing
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modRes.IsResidential"

End Function

Private Function GetResult(ByVal strXMLFileSpec As String) As String

    On Error GoTo EH
    
    Dim oXMLDoc As New MSXML2.DOMDocument30
    Dim oNode As MSXML2.IXMLDOMNode
    Dim oMsgNode As MSXML2.IXMLDOMNode
    Dim oNodeList As MSXML2.IXMLDOMNodeList
    
    Dim FSO As New Scripting.FileSystemObject
    
    If Not FSO.FileExists(strXMLFileSpec) Then
    
        GetResult = "FILE NOT FOUND"
        Exit Function
    
    End If
    
    ' Load DOM
    oXMLDoc.async = False
    oXMLDoc.Load strXMLFileSpec
    
    'Get a list of nodes
    Set oNodeList = oXMLDoc.selectNodes("//*")
    
    'loop through list and check for success and get res status
    For Each oNode In oNodeList
        If InStr(1, oNode.nodeName, "Notifications") > 0 Then
            For Each oMsgNode In oNode.childNodes
                If InStr(1, oMsgNode.nodeName, "Message") > 0 Then
                    GetResult = oMsgNode.Text
                    Exit Function
                End If
            Next
        ElseIf oNode.nodeName = "v1:ResidentialStatus" Then
                GetResult = oNode.Text
                Exit Function
        End If
    Next
    
Release:
    Set FSO = Nothing
    
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, "modRes.GetResult"
    Resume Release

End Function

Private Sub WriteError(ByVal strError As String, ByRef TheAddr As AddrData)
    
    On Error GoTo EH
    
    Dim FSO As New FileSystemObject
    Dim TSO As TextStream
    Dim strLine As String
    
    'Open daily error log file
    Set TSO = FSO.OpenTextFile(App.Path & "\VerifiErrors_" & Format(Date, "YYYYMMDD") & ".log", ForAppending, True)
    
    'Build the error line
    strLine = Now & ","
    strLine = strLine & strError & ","
    strLine = strLine & TheAddr.Addr1 & ","
    strLine = strLine & TheAddr.Addr2 & ","
    strLine = strLine & TheAddr.City & ","
    strLine = strLine & TheAddr.St & ","
    strLine = strLine & TheAddr.Zip
    
    'Write the error line
    TSO.WriteLine strLine
    
Release:
    TSO.Close
    Set TSO = Nothing
    Set FSO = Nothing
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, "modRes.WriteError"
    Resume Release

End Sub

